home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / cmln1085.arc / GSXCOLOR.INC < prev    next >
Text File  |  1986-02-27  |  4KB  |  106 lines
  1. {  --- color functions.  Include file GSXCOLOR.INC --- }
  2. {****************************************************************}
  3. procedure setcolor( index,            {in: requested color index}
  4.                      redi,            {in: red intensity 0-1000}
  5.                      greeni,          {in: green intensity 0-1000}
  6.                      bluei : integer  {in: blue intensity 0-1000}
  7.                      );
  8. {****************************************************************}
  9.   {procedure sets up a color index by defining the RGB intensities. }
  10.   var    contrl : array[1..5] of integer;
  11.           intin : array[1..4] of integer;
  12.          ptsin, intout, ptsout : integer;
  13.  
  14.   begin   contrl[1] := 14;
  15.           contrl[2] :=  0;
  16.           contrl[4] :=  4;
  17.            intin[1] := index;
  18.            intin[2] := redi;
  19.            intin[3] := greeni;
  20.            intin[4] := bluei;
  21.            setpblock( addr(contrl), addr(intin ),
  22.                       addr(ptsin ), addr(intout),
  23.                       addr(ptsout));
  24.            callgdos( addr(pb))
  25.   end;
  26.  
  27. {***************************************************************************}
  28. procedure setlinecolor( index : integer;  {in: color index requested 0-15}
  29.             var realizedcolor : integer   {out: index realized by the device}
  30.              );
  31. {***************************************************************************}
  32.   {color indices are defined by the procedure setcolor}
  33.   var     contrl : array[1..5] of integer;
  34.           intin, ptsin, intout, ptsout : integer;
  35.  
  36.   begin    contrl[1] := 17;
  37.            contrl[2] :=  0;
  38.            contrl[4] :=  1;
  39.            intin     := index;
  40.            setpblock( addr(contrl), addr(intin ),
  41.                       addr(ptsin ), addr(intout),
  42.                       addr(ptsout));
  43.            callgdos( addr(pb));
  44.            realizedcolor := intout
  45.   end;
  46.  
  47. {***********************************************************************}
  48. procedure setmarkercolor( index : integer;  {in: color requested 0-15}
  49.               var realizedcolor : integer   {out: color realized by device}
  50.               );
  51. {***********************************************************************}
  52.   {color indices are defined by the procedure setcolor}
  53.   var    contrl : array[1..5] of integer;
  54.          intin, ptsin, intout, ptsout : integer;
  55.  
  56.   begin  contrl[1] := 20;
  57.          contrl[2] :=  0;
  58.          contrl[4] :=  1;
  59.          intin     := index;
  60.          setpblock( addr(contrl), addr(intin ),
  61.                     addr(ptsin ), addr(intout),
  62.                     addr(ptsout));
  63.          callgdos( addr(pb));
  64.          realizedcolor := intout
  65.   end;
  66.  
  67. {***********************************************************************}
  68. procedure settextcolor( index : integer;  {in: text color index requested}
  69.             var realizedcolor : integer   {out: text color realized}
  70.              );
  71. {***********************************************************************}
  72.   {color indices are defined by the procedure setcolor}
  73.   var    contrl : array[1..5] of integer;
  74.          intin, ptsin, intout, ptsout : integer;
  75.  
  76.   begin   contrl[1] := 22;
  77.           contrl[2] :=  0;
  78.           contrl[4] :=  1;
  79.           intin     := index;
  80.           setpblock( addr(contrl), addr(intin ),
  81.                      addr(ptsin ), addr(intout),
  82.                      addr(ptsout));
  83.           callgdos( addr(pb));
  84.           realizedcolor := intout
  85.   end;
  86.  
  87. {***********************************************************************}
  88. procedure setfillcolor( index : integer;  {in: color requested 0-15}
  89.            var  realizedcolor : integer   {out: color realized}
  90.            );
  91. {***********************************************************************}
  92.   {color indices are defined by the procedure setcolor}
  93.   var    contrl : array[1..5] of integer;
  94.          intin, ptsin, intout, ptsout : integer;
  95.  
  96.   begin  contrl[1] := 25;
  97.          contrl[2] :=  0;
  98.          contrl[4] :=  1;
  99.          intin     := index;
  100.          setpblock( addr(contrl), addr(intin ),
  101.                     addr(ptsin ), addr(intout),
  102.                     addr(ptsout));
  103.          callgdos( addr(pb));
  104.          realizedcolor := intout
  105.   end;
  106.